unit wgetarcf;

{****************************************************************************}

interface

uses Wincrt,Windos,
      CartoCmds,        (* Contient les def. globales *)
      tit_win,get_win,gmuf_win,aux_win,coul_win;


(*************************** gethff - 3 Nov 90 *****************************)

function get_arcf(nomsc:st64; var Ext_File: st8;
                   var FormatType, nhead, nbands, nlig_capt,ncol_capt : integer): integer;

{****************************************************************************}

implementation

(*************************** getbmp - 5 Juin 91 *****************************)

function get_arcf(nomsc:st64; var Ext_File: st8;
                   var FormatType, nhead, nbands, nlig_capt, ncol_capt : integer): integer;

const
     card_capt = 8;

var   ier,i,l,k,n:integer;

      arcf:text;
      buf_arcf:array[1..512] of integer;
      char_arcf:array[1..512] of char;
      keyword : string;

      bandrowb,totalrowb : integer;
     _ligne:string;

label 999;

function read_ln(var f_in:text; var _S:String): integer;
var
  rc : char;
  nbchar : integer;
label 999;
begin

 {$I-}
  read_ln := -1;
  nbchar := 0; _S := '';
  repeat
    nbchar := nbchar + 1;
    read(f_in,rc); ier := ioresult;
    if ier <> 0 then begin read_ln := ier; goto 999; end;
    _S := _S+rc;
  until (nbchar = 255) or (ord(rc) = 10); (* Line feed *)
  if nbchar = 255 then begin read_ln := -2; goto 999; end;

  if length(_S) > 1 then _S := copy(_S,1,length(_S)-1)
    else begin _S := ''; read_ln := 0; goto 999; end;

  rc := _S[length(_S)];
  if ord(rc) = 13 then begin       (* Carriage return *)
    if length(_S) > 1 then _S := copy(_S,1,length(_S)-1)
      else _S := '';
  end;
  read_ln := 0;

 {$I+}
999:end;

begin

  get_arcf := 1;

  ncol_capt := 0;
  nlig_capt := 0;

  {$I-}

  assign(arcf,nomsc);
  reset(arcf);
  if ioresult <> 0 then begin get_arcf := -1; goto 999; end;

  repeat

  erreur := read_ln(arcf, _ligne);
  if erreur <> 0 then begin get_arcf := -1; goto 999; end;

  _nextpar(strw,_ligne);
  for i := 1 to length(strw) do strw[i] := upcase(strw[i]);

(*
  BYTEORDER      M
  LAYOUT       BIL
  NROWS         780
  NCOLS         1160
  NBANDS        3
  NBITS         8
  BANDROWBYTES         1160
  TOTALROWBYTES        3480
*)

  if strw = 'BYTEORDER' then begin
    _nextpar(strw,_ligne); for i := 1 to length(strw) do strw[i] := upcase(strw[i]);
    if copy(strw,1,1) <> 'M' then goto 999;
  end;
  if strw = 'LAYOUT' then begin
    _nextpar(strw,_ligne); ext_File := copy(strw,1,8);
  end;

  if strw = 'NROWS' then begin
    _nextpar(strw,_ligne); for i := 1 to length(strw) do strw[i] := upcase(strw[i]);
    val(strw,nlig_capt,ier);
    if ier <> 0 then goto 999;
  end;

  if strw = 'NCOLS' then begin
    _nextpar(strw,_ligne); for i := 1 to length(strw) do strw[i] := upcase(strw[i]);
    val(strw,ncol_capt,ier);
    if ier <> 0 then goto 999;
  end;

  if strw = 'NBANDS' then begin
    _nextpar(strw,_ligne); for i := 1 to length(strw) do strw[i] := upcase(strw[i]);
    val(strw,nbands,ier);
    if ier <> 0 then goto 999;
  end;

  if strw = 'NBITS' then begin
    _nextpar(strw,_ligne); for i := 1 to length(strw) do strw[i] := upcase(strw[i]);
    val(strw,FormatType,ier);
    if ier <> 0 then goto 999;
  end;

  if strw = 'BANDROWBYTES' then begin
    _nextpar(strw,_ligne); for i := 1 to length(strw) do strw[i] := upcase(strw[i]);
    val(strw,BandRowb,ier);
    if ier <> 0 then goto 999;
  end;

  if strw = 'TOTALROWBYTES' then begin
    _nextpar(strw,_ligne); for i := 1 to length(strw) do strw[i] := upcase(strw[i]);
    val(strw,TotalRowb,ier);
    if ier <> 0 then goto 999;
  end;

  nhead := TotalRowb - nbands*Bandrowb;

  until eof(arcf);

  close(arcf);
  get_arcf := 0;

999:end;

end.

